HPAVC/HPAVC CD-ROM.iso/pc/TARCHIV.ZIP/TAPEARC.PAS

Pascal/Delphi Source File | 1995-01-27 | 12.5 KB | 431 lines

{ TAPEARC.TPU }

{ Andreas Schiffler, U of S, 1994 }

{ This unit derives a tape-archiver object from the archiver object which }
{ works with the EXB-8500 tape drive, i.e. uses ASPI.TPU. A lot of effort }
{ goes into error checking, but when the tape locks for more than TIMEOUT }
{ minutes the program will be aborted with a DOS error code 1.            }

Unit TapeArc;

interface

Uses Dos, Arc, Aspi, Logfile, ToolBox;

type
  PTapeArchiver = ^TTapeArchiver;
  TTapeArchiver = object (TArchiver)
                    { Configure these externally }
                    Timeout         : Byte;
                    TapeKBytes      : Longint;
                    KBytesThreshold : Longint;
                    DoTime          : Boolean;
                    { Wordy : Boolean;        }
                    { DisplayFlag : Boolean;  }

                    { }
                    DoReset    : Boolean;
                    Tape       : PASPITape;
                    SaveSet    : Word;
                    StartBlock : Longint;
                    DoErase    : Boolean;

                    Constructor Init (LUN_SaveSet : String;
                                      NewIOMode : tIOMode;
                                      InfoLogFilename : String;
                                      ErrorLogfilename : String;
                                      DoResetFlag : Boolean;
                                      DoEraseFlag : Boolean;
                                      DoMemDisp   : Boolean);
                    Destructor  Done; virtual;

                    Procedure TestTapeReady;
                    Procedure TapeErrorCheck (Where : String);
                    Procedure SetTapeSize (SizeStr : String);

                    { I/O primitives }
                    Procedure OpenArchive; virtual;
                    Procedure CloseArchive; virtual;
                    Procedure ReadBlock; virtual;
                    Procedure WriteBlock; virtual;
                    Procedure SeekBlock (NewBlockNum : Longint); virtual;
                  end;

implementation

Constructor TTapeArchiver.Init (LUN_SaveSet : String;
                               NewIOMode : tIOMode;
                               InfoLogFilename : String;
                               ErrorLogfilename : String;
                               DoResetFlag : Boolean;
                               DoEraseFlag : Boolean;
                               DoMemDisp   : Boolean);
Var
 Result  : Integer;
 LUN     : Byte;
 S,SS    : String;
Begin
 { Parameters }
 { ... from Init }
 IOMode := NewIOMode;
 DoReset := DoResetFlag;
 { ... presets }
 TapeKBytes := 0;
 DisplayFlag := False;
 TotalSize := 0;
 TotalFiles := 0;
 KBytesThreshold := 5000;
 Timeout := 15;
 DoTime := True;
 ArchiveName := 'Nothing';
 Wordy := True;
 DoErase := DoEraseFlag;
 Val(Copy(LUN_SaveSet,1,Pos(':',LUN_SaveSet)-1),LUN,Result);
 Delete (LUN_SaveSet,1,Pos(':',LUN_SaveSet));
 DirectoryFilename := '#'+LUN_SaveSet+'.DIR';
 Val(LUN_SaveSet,SaveSet,Result);
 { Logfile }
 New (ErrorLog,Init(ErrorLogfilename));
 New (InfoLog,Init(InfoLogFilename));
 { Data storage }
 New (Block);
 If Block=NIL Then Begin
  ErrorLog^.Writelog ('Allocation of write block: out of memory');
  Fail;
 End;
 New (FileBlock);
 If FileBlock=NIL Then Begin
  ErrorLog^.Writelog ('Allocation of read block: out of memory');
  Dispose (Block);
  Fail;
 End;
 FillChar (Block^,SizeOf(TBlock),0);
 FillChar (FileBlock^,SizeOf(TBlock),0);
 { Directory }
 New (DirCollection,Init(20,20));
 If DirCollection=NIL Then Begin
  ErrorLog^.Writelog ('Allocation of directory: out of memory');
  Dispose (Block);
  Dispose (FileBlock);
  Fail;
 End;
 { Tape }
 New (Tape,Init(LUN));
 If Tape=NIL Then Begin
  ErrorLog^.Writelog ('Allocation of tape object: out of memory');
  Dispose (Block);
  Dispose (FileBlock);
  Dispose (DirCollection,Done);
  Fail;
 End;
 { Device inquiry }
 Tape^.Inquiry;
 If Wordy Then InfoLog^.Writelog ('['+Tape^.Info.Device+'] '+Tape^.Info.Product+' by '+Tape^.Info.Vendor);
 { SCSI device found }
 If NOT Tape^.Info.Valid Then Begin
  ErrorLog^.Writelog ('Checking SCSI-device: no valid SCSI device found');
  Dispose (Block);
  Dispose (FileBlock);
  Dispose (DirCollection,Done);
  Dispose (Tape,Done);
  Fail;
 End;
 { Open }
 OpenArchive;
 If Tape=NIL Then Begin
  ErrorLog^.Writelog ('Initializing tape: operation unsuccessful');
 End;
 { Show memory information }
 If DoMemDisp Then Begin
  Str (MaxAvail,S);
  Str ((MaxAvail DIV DirItemSize),SS);
  Commas (S);
  Commas (SS);
  InfoLog^.Writelog ('There are '+S+' bytes free to handle '+SS+' files.');
 End;
End;

Destructor TTapeArchiver.Done;
Var
 S1,S2 : String;
Begin
 If Wordy And (TotalFiles>0) Then Begin
  Str (TotalSize,S1);
  Str (TotalFiles,S2);
  InfoLog^.Writelog ('Processed '+S1+' bytes in '+S2+' files.');
 End;
 { Close }
 CloseArchive;
 { Data }
 Dispose (Block);
 Dispose (FileBlock);
 Dispose (DirCollection,Done);
 Dispose (Tape,Done);
 Dispose (ErrorLog);
 Dispose (InfoLog);
 { Directory }
 EraseDirectory;
End;

{ Return the number of physical blocks available in the tape of type }
{ 'SizeStr'. Each physical block holds 1 KB of data.                 }
Procedure TTapeArchiver.SetTapeSize (SizeStr : String);
Type
 TSizes = Record
           Name    : String[6];
           Blocks  : Longint;
          End;
Const
 Sizes = 9;
 SizeArray : Array [1..Sizes] Of TSizes = (
                                           (Name : 'P5-15';
                                            Blocks: $ccd50),
                                           (Name : 'P5-30';
                                            Blocks: $18e880),
                                           (Name : 'P5-60';
                                            Blocks: $311ed0),
                                           (Name : 'P5-90';
                                            Blocks: $49ab40),
                                           (Name : 'P6-15';
                                            Blocks: $8c440),
                                           (Name : 'P6-30';
                                            Blocks: $118290),
                                           (Name : 'P6-60';
                                            Blocks: $22ff20),
                                           (Name : 'P6-90';
                                            Blocks: $347bc0),
                                           (Name : 'P6-120';
                                            Blocks: $45f840)
                                          );
Var
 Counter : Byte;
Begin
 { Match descriptor }
 SizeStr := Upper(SizeStr);
 For Counter := 1 To Sizes Do Begin
  If SizeArray[Counter].Name=SizeStr Then Begin
   TapeKBytes := SizeArray[Counter].Blocks;
   Exit;
  End;
 End;
 { No match ... default to maximum size }
 If Wordy Then InfoLog^.Writelog ('Cannot match tape descriptor for size determination.');
 TapeKBytes := SizeArray[4].Blocks;
End;

Procedure TTapeArchiver.TapeErrorCheck (Where : String);
Var
 Now   : Longint;
 ATime : DateTime;
 Dummy : Word;
Begin
 If Tape^.Status.Error Then Begin
  Tape^.ParseStatus;
  { Prepare current time }
  GetTime (ATime.Hour,ATime.Min,ATime.Sec,Dummy);
  GetDate (ATime.Year,ATime.Month,ATime.Day,Dummy);
  PackTime(ATime,Now);
  If DoTime Then ErrorLog^.Writelog ('@ '+TimeString(Now)+':');
  { Text }
  ErrorLog^.Writelog('['+Where+']: tape error detected');
  ErrorLog^.Writelog(' ASPI  : '+Tape^.Status.ASPI);
  ErrorLog^.Writelog(' Host  : '+Tape^.Status.Host);
  ErrorLog^.Writelog(' Target: '+Tape^.Status.Target);
  ErrorLog^.Writelog(' Sense : '+Tape^.Status.Sense);
  If Tape^.Status.SenseExt<>'' Then ErrorLog^.Writelog('         '+Tape^.Status.SenseExt);
 End;
End;

Procedure TTapeArchiver.ReadBlock;
Var
 Result : Word;
Begin
 TestTapeReady;
 Tape^.ReadData (Block,Blocksize);
 TapeErrorCheck ('Reading');
 { Update counters }
 BlockOfs := 0;
 Inc (BlockNum);
End;

Procedure TTapeArchiver.WriteBlock;
Begin
 If BlockOfs<Blocksize Then FillChar(Block^[BlockOfs],Blocksize-BlockOfs,0);
 TestTapeReady;
 Tape^.WriteData (Block,Blocksize);
 TapeErrorCheck ('Writing');
 BlockOfs := 0;
 Inc (BlockNum);
End;

Procedure TTapeArchiver.SeekBlock (NewBlockNum : Longint);
Begin
 If (BlockNum+1)<>NewBlockNum Then Begin
  TestTapeReady;
  Tape^.LocateTape (Longint(StartBlock)+Longint(NewBlockNum));
  TapeErrorCheck ('Seeking');
  BlockNum := Longint(NewBlockNum)-1;
 End;
 ReadBlock;
End;

Procedure TTapeArchiver.OpenArchive;
Var
 S: String;
Begin
 { Initial ready check }
 If DoReset Then Tape^.ASPIReset;
 If Wordy Then InfoLog^.Writelog ('Waiting for tape to come online');
 TestTapeReady;
 { Check for tape }
 If Tape^.Status.TapeNotPresent Then Begin
  ErrorLog^.Writelog ('Checking SCSI-device: no tape present');
  Dispose (Tape,Done);
  Exit;
  Tape := NIL;
 End;
 { Check write protection }
 If (IOMode=fWrite) AND (Tape^.Status.WriteProtectOn) Then Begin
  ErrorLog^.Writelog ('Checking SCSI-device: write protect on');
  Dispose (Tape,Done);
  Exit;
  Tape := NIL;
 End;
 { Set blocksize }
 Tape^.ModeSelect(Blocksize);
 TapeErrorCheck ('Mode select');
 { Seek to end of n-th saveset: 1=stay, 2=skip 1, 3=skip 2, ... }
 If SaveSet>1 Then Begin
  Str (SaveSet,S);
  If Wordy Then InfoLog^.Writelog ('Seeking to saveset #'+S);
  TestTapeReady;
  Tape^.SpaceFilemark (SaveSet-1);
  TapeErrorCheck ('Spacing over filemarks');
  If Tape^.Status.Error Then Begin
   Dispose (Tape,Done);
   Exit;
   Tape := NIL;
  End;
 End;
 { Erase if necessary, rewind and seek again }
 If (IOMode=fWrite) AND DoErase Then Begin
  If Wordy Then InfoLog^.Writelog ('Erasing tape (25 min/GByte)');
  TestTapeReady;
  Tape^.Erase;
  TapeErrorCheck ('Erasing tape');
  TestTapeReady;
  Tape^.Rewind;
  TapeErrorCheck ('Rewinding');
  { Seek to end of n-th saveset: 1=stay, 2=skip 1, 3=skip 2, ... }
  If SaveSet>1 Then Begin
   Str (SaveSet,S);
   If Wordy Then InfoLog^.Writelog ('Seeking to saveset #'+S);
   TestTapeReady;
   Tape^.SpaceFilemark (SaveSet-1);
   TapeErrorCheck ('Spacing over filemarks');
   If Tape^.Status.Error Then Begin
    Dispose (Tape,Done);
    Exit;
    Tape := NIL;
   End;
  End;
 End;
 { Determine starting block }
 TestTapeReady;
 StartBlock := Tape^.TapePosition;
 TapeErrorCheck ('Determining position');
 { Prepare block and counters }
 Case IOMode of
  fRead:  Begin BlockNum := -1; ReadBlock; End;
  fWrite: Begin BlockNum := 0; BlockOfs := 0; End;
 End;
End;

Procedure TTapeArchiver.CloseArchive;
Var
 CurrentBlock : Longint;
 KBytesLeft : Longint;
 KBytesUsed : Longint;
 S,SS       : String;
Begin
 If Wordy Then InfoLog^.Writelog ('Closing tape and rewinding');
 { In Write-Mode ? }
 If IOMode=fWrite Then Begin
  { Flush block }
  If BlockOfs<>0 Then WriteBlock;
  { End the archive with a filemark ... }
  TestTapeReady;
  Tape^.WriteFilemark (1);
  TapeErrorCheck ('Writing filemark');
 End;
 { Calculate bytes left and output }
 If (TapeKBytes<>0) And Wordy And (IOMode=fWrite) Then Begin
  { Determine current block }
  TestTapeReady;
  CurrentBlock := Tape^.TapePosition;
  TapeErrorCheck ('Determining position');
  { Calculcate capacities }
  KBytesLeft := TapeKBytes - CurrentBlock*(Blocksize DIV 1024) - SaveSet +1;
  KBytesUsed := CurrentBlock*(Blocksize DIV 1024) + Saveset -1;
  Str (KBytesLeft:9,S);
  Commas (S);
  Str (KBytesUsed:9,SS);
  Commas (SS);
  InfoLog^.Writelog ('Tape statistics: '+SS+' KBytes used / '+S+' KBytes free');
  If (KBytesLeft<KBytesThreshold) Then ErrorLog^.Writelog ('Warning: Tape capacity is low!  ('+S+' KBytes free).');
 End;
 { ... and rewind. }
 TestTapeReady;
 Tape^.Rewind;
 TapeErrorCheck ('Rewinding');
End;

Procedure TTapeArchiver.TestTapeReady;
Var
  Hour,
  Minute,
  Second,
  MSecond,
  OldSecond,
  MinuteInfo,
  MinuteEnd,
  CountDown : Word;
  S         : String;
Begin
 { Quick check }
 Tape^.TestUnitReady;
 If Tape^.Status.Error Then Begin
  { Check every second until timeout is reached }
  Dos.GetTime (Hour,Minute,Second,MSecond);
  MinuteEnd := (Minute + Timeout) MOD 60;
  MinuteInfo := (Minute + 2) MOD 60;
  OldSecond := Second;
  Countdown := Timeout-2;
  Repeat
   Dos.GetTime (Hour,Minute,Second,MSecond);
   If OldSecond<>Second Then Begin
    OldSecond := Second;
    Tape^.TestUnitReady;
   End;
   { Give the current status every minute }
   If Minute=MinuteInfo Then Begin
    Str (Countdown,S);
    TapeErrorCheck ('Waiting for tape '+S+' more minutes');
    MinuteInfo := (Minute + 1) MOD 60;
    Dec (Countdown);
   End;
  Until ((NOT Tape^.Status.Error) OR (MinuteEnd=Minute));
  { If still in error status, then halt program, i.e. there is nothing }
  { we can do. }
  If Tape^.Status.Error Then Begin
   Str (Timeout,S);
   ErrorLog^.Writelog ('Fatal error: tape not ready after '+S+' minutes');
   Halt (1);
  End;
 End;
End;

Begin
End.